home *** CD-ROM | disk | FTP | other *** search
/ SGI Hot Mix 14 / Hot Mix 14.iso / HTML / vendors / finesse / examples / perl / stars < prev   
Text File  |  1996-06-27  |  6KB  |  256 lines
  1. #!/usr/local/bin/perl
  2. # FINESSEAPPLICATIONKEY sSoCbg^X_HzYv
  3.  
  4. $ENV{'FINESSEPATH'} = '/usr/local/finesse'
  5.     if !$ENV{'FINESSEPATH'};
  6. require("$ENV{'FINESSEPATH'}/fsperlinit");
  7.  
  8. # read primitive database and prepare lists
  9.  
  10. require("$ENV{'FINESSEPATH'}/examples/perl/.starsdb");
  11. &make_random_lists;
  12.  
  13. # define user interface
  14.  
  15. $choicelabel = "Random
  16. Choice";
  17.  
  18. $windef = "FsWindow -name starswin
  19.            -title stars;
  20.   FsRadio  -var fsmode -label Mode: -winstat touch
  21.            -fsbutton fsmode 
  22.            -items 'Beginner Expert Answer';
  23.   FsForm   -name topform
  24.            -orientation horizontal;
  25.   FsList   -label Constellation: 
  26.            -inputsep '/'
  27.            -outputsep '/'
  28.            -mode single
  29.            -items '$list_of_consts'
  30.            -var const
  31.            -name const
  32.            -expert show
  33.            -parent topform
  34.            -nvisible 15;
  35.   FsList   -label 'List of Stars:'
  36.            -inputsep '/'
  37.            -outputsep '/'
  38.            -items '$list_of_stars'
  39.            -nvisible 15
  40.            -var fsstars
  41.            -name fsstars
  42.            -expert show
  43.            -parent topform
  44.            -mode single;
  45.   FsLabel  -label 
  46.            'Press \\'Random Choice\\' to select constellation:' 
  47.            -name fsresult;
  48.   FsList   -label 'Relation:'
  49.            -inputsep '/'
  50.            -outputsep '/'
  51.            -items ''
  52.            -var rel
  53.            -name rel
  54.            -nvisible 5;
  55.   FsPushButton -label '$choicelabel'
  56.                -name choice -fsbutton Choice
  57.                -winstat touch;
  58.   FsPushButton -label Show -name show
  59.                -winstat touch;
  60.   FsPushButton -label Clear -name clear
  61.                -winstat touch;
  62.   FsPushButton -label Exit -fsbutton a;
  63. "; 
  64.  
  65. &Fsopen(@ARGV);
  66. &Fsdisplay("-w", "$windef", "-n", "starswin");
  67.  
  68. while () {
  69.   if ( $fsbutton eq "fsmode" ) {
  70.  
  71.       # Change of mode in radio box 'Mode'
  72.  
  73.       @fsdargs = &get_fsmode_args($fsmode);
  74.  
  75.   } elsif ( $fsbutton eq "Choice" ) {
  76.  
  77.       # Button 'Choice' was pressed
  78.  
  79.       if (( $fsmode eq "Beginner" ) || 
  80.       ( $fsmode eq "Expert" )) {
  81.       @fsdargs = &get_choice_args($fsmode);
  82.       }
  83.   } elsif ( $fsbutton eq "Show" ) {
  84.  
  85.       # Button 'Show' was pressed
  86.  
  87.       if ( $fsmode eq "Beginner" ) {
  88.       @fsdargs = 
  89.           &get_beginner_args($allstars{$const},$fsstars);
  90.       } elsif ( $fsmode eq "Expert" ) {
  91.       @fsdargs = 
  92.           &get_expert_args($allstars{$const},$fsstars);
  93.       } elsif ( $fsmode eq "Answer" ) {
  94.       @fsdargs = &get_answer_args($const,$fsstars);
  95.       }
  96.   } elsif ( $fsbutton eq "Clear" ) {
  97.       @fsdargs = @clear;
  98.   } else {
  99.       last;
  100.   }
  101.   &Fsdisplay("-n", "starswin", @fsdargs);
  102. }
  103.  
  104. &Fsclose;
  105.  
  106. #
  107. # functions
  108. #
  109.  
  110. sub make_random_lists {
  111.  
  112. # make list of stars and constellations
  113.  
  114.     srand(time|$$);
  115.  
  116.     foreach $value (values (%allstars)) {
  117.     @all_stars = (@all_stars, split('/', $value));
  118.     }
  119.     @all_consts = keys(%allstars);
  120.  
  121. # make lists random for window declaration
  122.  
  123.     push(@rand_stars, splice(@all_stars, rand @all_stars, 1)) 
  124.     while (@all_stars);
  125.     $list_of_stars = join('/', @rand_stars);
  126.     
  127.     push(@rand_const, splice(@all_consts, rand @all_consts, 1)) 
  128.     while (@all_consts);
  129.     $list_of_consts = join('/', @rand_const);
  130.  
  131. # prepare clearing of lists
  132.  
  133.     @clear = ("-v", "const=*[unselect]",
  134.           "-v", "fsstars=*[unselect]",
  135.           "-v", "rel=*[delete]",
  136.           "-r", "fsresult:labelString:");
  137. }
  138.  
  139. sub get_fsmode_args {
  140.  
  141.     # prepare window setup according to selected mode
  142.  
  143.     if ( $_[0] eq "Beginner" ) {
  144.     $fslabel = "Push Choice to Select Constellation:";
  145.     $constpol = "XmBROWSE_SELECT";
  146.     $starspol = "XmBROWSE_SELECT";
  147.     } elsif ( $_[0] eq "Expert" ) {
  148.     $fslabel = "Push Choice to Select Constellation:";
  149.     $constpol = "XmBROWSE_SELECT";
  150.     $starspol = "XmEXTENDED_SELECT";
  151.     } elsif ( $_[0] eq "Answer" ) {
  152.     $fslabel = "Select Constellation and Stars:";
  153.     $constpol = "XmEXTENDED_SELECT";
  154.     $starspol = "XmEXTENDED_SELECT";
  155.     }
  156.     
  157.     ("-r", "fsresult:labelString:$fslabel", @clear,
  158.      "-r", "const:selectionPolicy:$constpol",
  159.      "-r", "fsstars:selectionPolicy:$starspol");
  160. }
  161.  
  162. sub get_choice_args {
  163.  
  164.     #  make random choice in list of stars
  165.  
  166.     if ( $_[0] eq "Beginner" ) {
  167.     $fslabel = 
  168.         "Select corresponding main star and press 'Show'";
  169.     } elsif ( $_[0] eq "Expert" ) {
  170.     $fslabel = 
  171.         "Select corresponding stars and press 'Show'";
  172.     }
  173.     ("-v", "rel=*[delete]", "-v",
  174.      "const=*[unselect]/$rand_const[rand(@rand_const)]",
  175.      "-r", "fsresult:labelString:$fslabel");
  176. }
  177.  
  178. sub get_answer_args {
  179.  
  180.     # determine answer for selections
  181.  
  182.     local(%MARK, $entry, @chosenstars);
  183.  
  184.     # begin with chosen constellations
  185.  
  186.     if ("$_[0]") {
  187.     @const = split(/\//,$_[0]);
  188.     foreach (@const) {
  189.         @stars = split(/\//, $allstars{$_});
  190.         push(@chosenstars, @stars);
  191.     }
  192.     }
  193.  
  194.     # add chosen stars not yet processed
  195.       
  196.     if ("$_[1]") {
  197.     @stars = split(/\//, $_[1]);
  198.     grep($MARK{$_}++, @askedstars);
  199.     @remainingstars = grep(!$MARK{$_}, @stars);
  200.     push(@chosenstars, @remainingstars);
  201.     }
  202.     
  203.     foreach (@chosenstars) {
  204.     $entry = "$entry$_: $genitive{$_}/";
  205.     }
  206.     
  207.     ("-v", "rel=*[delete]/$entry*[unselect]");
  208. }
  209.  
  210. sub get_beginner_args {
  211.  
  212.     # compare main star with guess
  213.  
  214.     if ("$_[0]" && "$_[1]") {
  215.     ($answer) = split(/\//,$_[0]);
  216.     if ( "$answer" eq "$_[1]" ) {
  217.         $fslabel = "Congratulations!" ;
  218.     } else {
  219.         $fslabel = "Sorry." ;
  220.     }
  221.     ("-v", "rel=*[delete]/$answer: $genitive{$answer}/*[unselect]",
  222.      "-r", "fsresult:labelString:$fslabel");
  223.     } else {
  224.     $fslabel = 
  225.         "Select constellation and main star first." ;
  226.     ("-r", "fsresult:labelString:$fslabel");
  227.     }
  228. }
  229.  
  230. sub get_expert_args {
  231.  
  232.     # compare all stars of const with guess
  233.  
  234.     if ("$_[0]" && "$_[1]") {
  235.     local(%MARK);
  236.  
  237.     @answer = split(/\//,$_[0]);
  238.     @guess = split(/\//,$_[1]);
  239.     
  240.     grep($MARK{$_}++, @answer);
  241.     $hits = grep($MARK{$_}, @guess);
  242.     $misses = @answer - $hits;
  243.     $errors = @guess - $hits;
  244.     $fslabel = 
  245.         "Hits: $hits, Misses: $misses, Errors: $errors";
  246.  
  247.     ("-v", "rel=*[delete]/$_[0]/*[unselect]",
  248.      "-r", "fsresult:labelString:$fslabel");
  249.     } else {
  250.     $fslabel = "Select constellation and stars first." ;
  251.     ("-r", "fsresult:labelString:$fslabel");
  252.     }
  253. }
  254.  
  255.  
  256.